home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBFIELDS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  10KB  |  401 lines
  1. UNIT PbFIELDS;
  2.  
  3. INTERFACE
  4.  
  5. uses CRT, PbCRT, PbMISC;
  6.  
  7. {
  8. Description : One chunk of screen, entry of data.
  9.  
  10. Author      : Howard Richoux
  11. Date        : 2/04/94
  12. Last revised: 2/10/94 data space revisions - see note below
  13.               2/18/94 NEW LIBRARIES
  14. Application : IBM PC and compatibles, done in Turbo Pascal 7
  15. Status      : Placed in the Public Domain by HNR Software 1/94
  16. Published in: none
  17.  
  18. Data space was going wild until I discovered that each field was allocating
  19. 3 255 byte strings ( working, original and prompt )  These were trimmed to
  20. 80, 80 and 24 and made global.  This means that ALL fields share the same
  21. working space.  It would not be possible to interrupt field input to enter
  22. another field and resume later.  This should NOT be a real limitation.
  23.  
  24. String variables are limited to 80 chars.
  25.  
  26. }
  27. {----------------------------------------------------------------------------}
  28. {since there is only one field being edited at any instant, these are global }
  29.  
  30. var FLD_working   : string[80];      { string being edited           }
  31. var FLD_original  : string[80];      { copy of FLD_original string for esc }
  32. var FLD_prompt    : string[24];      { to the left of (x,y)          }
  33.  
  34. {----------------------------------------------------------------------------}
  35.  
  36. type FIELD_object = object
  37.               x,y,l     : byte;        { point and entry length        }
  38.               TC        : char;        { terminating (exit) character  }
  39.               modified  : boolean;     { set if field modified by user }
  40.               readonly  : boolean;     { display only if true          }
  41.  
  42.               Procedure init(row,col,ll : byte; pr : string);
  43.               Procedure done;                      { cleanup }
  44.               Procedure display (    str : string);
  45.               Function  input   (var str : string) : boolean;  { maj/min exit }
  46.               Procedure dump;
  47.               end;
  48.  
  49.  
  50.  
  51. type STRING_FIELD_object = object(FIELD_object)
  52.               st        : string[80];
  53.               Upshift   : boolean;
  54.               Procedure init    (row,col,ll : byte; pr : string);
  55.               Procedure SetUpShift;
  56.               Procedure display (str : string);
  57.               Function  input   (var str : string) : boolean;
  58.               Procedure dump;
  59.               end;
  60.  
  61.  
  62. type DBDATE_FIELD_object = object(FIELD_object)
  63.               dt         : string[8];
  64.               Procedure init    (row,col,ll : byte; pr : string);
  65.               Procedure display (str : string);
  66.               Function  input   (var str : string) : boolean;
  67.               Procedure dump;
  68.               end;
  69.  
  70.  
  71. type REAL_FIELD_object = object(FIELD_object)
  72.               rr        : real;
  73.               decp      : byte;
  74.               Procedure init    (row,col,ll,dcp : byte; pr : string);
  75.               Procedure display ( r : real);
  76.               Function  input   (var r : real) : boolean;
  77.               Procedure dump;
  78.               end;
  79.  
  80.  
  81.  
  82. type INTEGER_FIELD_object = object(FIELD_object)
  83.               ii         : integer;
  84.               Procedure init    (row,col,ll : byte; pr : string);
  85.               Procedure display (i : integer);
  86.               Function  input   (var i : integer) : boolean;
  87.               Procedure dump;
  88.               end;
  89.  
  90.  
  91.  
  92. type LONGINT_FIELD_object = object(FIELD_object)
  93.               ll         : longint;
  94.               Procedure init    (row,col,llx : byte; pr : string);
  95.               Procedure display (lng : longint);
  96.               Function  input   (var lng : longint) : boolean;
  97.               Procedure dump;
  98.               end;
  99.  
  100.  
  101.  
  102. {SECTION .ZIMPLEMENTATION }
  103. IMPLEMENTATION
  104.  
  105. Function  MaxFieldLen(col,ln : integer) : integer;
  106. var l : integer;
  107.      begin
  108.      l := (80 - col);
  109.      if l > ln then l := ln;
  110.      MaxFieldLen := l;
  111.      end;
  112.  
  113.  
  114. {SECTION  FIELD_object }
  115. Procedure FIELD_object.init(row,col,ll : byte; pr : string);
  116.      begin
  117.      modified := false;
  118.      readonly := false;
  119.      FLD_prompt   := pr;
  120.      FLD_working := '';
  121.      FLD_original := '';
  122.      l := ll;     y := row;     x := col;
  123.      TC := ' ';
  124.      end;
  125.  
  126.  
  127. Procedure FIELD_object.done;          { cleanup }
  128.      begin
  129.      end;
  130.  
  131.  
  132. Procedure FIELD_object.dump;
  133.      begin
  134.      gotoxy(1,4);write('dump (',x,',',y,') [',FLD_prompt,'] [',FLD_working,']');
  135.      end;
  136.  
  137.  
  138. Procedure FIELD_object.display( str : string);
  139. var ok : boolean;
  140.      begin
  141.      FLD_working  := str;
  142.      ok := InputStr(y,x,FLD_prompt,FLD_working,l,'O',TC);  { for now }
  143.      end;
  144.  
  145.  
  146. Function  FIELD_object.input(var str : string) : boolean;
  147. var ok : boolean;
  148.      begin
  149.      TC := ' ';
  150.      FLD_working  := str;
  151.      FLD_original := str;
  152.      if readonly then begin input := false; exit; end;
  153.      ok := InputStr(y,x,FLD_prompt,FLD_working,l,'U',TC);  { for now }
  154.      if TC = #27 then FLD_working := FLD_original;
  155.      str := FLD_working;
  156.      input := ok;
  157.      end;
  158.  
  159.  
  160. { ----------------------------------------------------------------------- }
  161.  
  162. {SECTION  STRING_FIELD_object }
  163. Procedure STRING_FIELD_object.init(row,col,ll : byte; pr : string);
  164. var lx : integer;
  165.      begin
  166.      st := '';
  167.      lx := MaxFieldLen(col,ll);
  168.      FIELD_object.init(row,col,lx,pr);
  169.      Upshift  := false;
  170.      if Upshift then FLD_working := UpCaseStr(FLD_working);
  171.      end;
  172.  
  173.  
  174. Procedure STRING_FIELD_object.SetUpShift;
  175. var s : string;
  176.      begin
  177.      Upshift := true;
  178.      end;
  179.  
  180.  
  181. Procedure STRING_FIELD_object.display( str : string);
  182. var s : string;
  183.      begin
  184.      st := str;
  185.      FLD_working := st;
  186.      if Upshift then FLD_working := UpCaseStr(FLD_working);
  187.      FIELD_object.display(FLD_working);
  188.      end;
  189.  
  190.  
  191. Procedure STRING_FIELD_object.dump;
  192.      begin
  193.      FIELD_object.dump;
  194.      write('  st=[',st,']');
  195.      end;
  196.  
  197.  
  198. Function  STRING_FIELD_object.input(var str : string) : boolean;
  199. var ok : boolean;
  200.      begin
  201.      FLD_working := str;
  202.      if Upshift then FLD_working := UpCaseStr(FLD_working);
  203.      ok := FIELD_object.input(FLD_working);
  204.      st := FLD_working;
  205.      str := st;
  206.      display(str);
  207.      input := ok;
  208.      end;
  209.  
  210.  
  211. { ----------------------------------------------------------------------- }
  212.  
  213.  
  214. {SECTION  DBDATE_FIELD_object }
  215. Procedure DBDATE_FIELD_object.init(row,col,ll : byte; pr : string);
  216. var s  : string;
  217.     lx : integer;
  218.      begin
  219.      if ll > 8 then lx := 8
  220.      else lx := ll;
  221.      lx := MaxFieldLen(col,lx);
  222.      FIELD_object.init(row,col,ll,pr);
  223.      end;
  224.  
  225.  
  226. Procedure DBDATE_FIELD_object.dump;
  227.      begin
  228.      FIELD_object.dump;
  229.      write('  dt=[',dt,']    formatted [',FmtPDateStr(DBaseToPTime(dt)),']');
  230.      end;
  231.  
  232.  
  233. Procedure DBDATE_FIELD_object.display(str : string);
  234. var s : string;
  235.      begin
  236.      dt := str;
  237.      FLD_working := FmtPDateStr(DBaseToPTime(dt));
  238.      FIELD_object.display(FLD_working);
  239.      end;
  240.  
  241.  
  242. Function  DBDATE_FIELD_object.input(var str : string) : boolean;
  243. var ok : boolean;
  244. var s  : string;
  245.     yy,mm,dd : integer;
  246.      begin
  247.      FLD_working := FmtPDateStr(DBaseToPTime(dt));
  248.      ok := FIELD_object.input(FLD_working);
  249.      StrCal(FLD_working,dd,mm,yy);
  250.      dt := integerstr(1900+yy,4) + integerstr(mm,2)+integerstr(dd,2);
  251.      patchstr(dt,' ','0');
  252.      display(dt);
  253.      str := dt;
  254.      input := ok;
  255.      end;
  256.  
  257.  
  258.  
  259. { ----------------------------------------------------------------------- }
  260.  
  261.  
  262. {SECTION  REAL_FIELD_object }
  263. Procedure REAL_FIELD_object.init(row,col,ll,dcp : byte; pr : string);
  264. var s  : string;
  265.     lx : integer;
  266.      begin
  267.      rr := 0;
  268.      decp := dcp;
  269.      if ll > 14 then lx := 14
  270.      else lx := ll;
  271.      lx := MaxFieldLen(col,lx);
  272.      FIELD_object.init(row,col,ll,pr);
  273.      end;
  274.  
  275.  
  276. Procedure REAL_FIELD_object.dump;
  277.      begin
  278.      FIELD_object.dump;
  279.      write('  rr=[',rr:10:3,']    formatted [',RealStr(rr,10,3),']');
  280.      end;
  281.  
  282.  
  283. Procedure REAL_FIELD_object.display( r : real);
  284. var s : string;
  285.      begin
  286.      rr := r;
  287.      FLD_working := RealStr(rr,l,decp);
  288.      FIELD_object.display(FLD_working);
  289.      end;
  290.  
  291.  
  292. Function  REAL_FIELD_object.input(var r : real) : boolean;
  293. var ok : boolean;
  294. var s  : string;
  295.     yy,mm,dd : integer;
  296.      begin
  297.      FLD_working := trimstr(RealStr(rr,l,decp));
  298.      ok := FIELD_object.input(FLD_working);
  299.      rr := StrReal(FLD_working);
  300.      r := rr;
  301.      display(r);
  302.      input := ok;
  303.      end;
  304.  
  305.  
  306.  
  307. {SECTION  INTEGER_FIELD_object }
  308. Procedure INTEGER_FIELD_object.init(row,col,ll : byte; pr : string);
  309. var s : string;
  310.     lx : integer;
  311.      begin
  312.      ii := 0;
  313.      if ll > 6 then lx := 6
  314.      else lx := ll;
  315.      lx := MaxFieldLen(col,lx);
  316.      FIELD_object.init(row,col,lx,pr);
  317.      end;
  318.  
  319.  
  320. Procedure INTEGER_FIELD_object.dump;
  321.      begin
  322.      FIELD_object.dump;
  323.      write('  [',ii,'] ');
  324.      end;
  325.  
  326.  
  327. Procedure INTEGER_FIELD_object.display( i : integer );
  328. var s : string;
  329.      begin
  330.      ii := i;
  331.      FLD_working := integerstr(ii,l);
  332.      FIELD_object.display(FLD_working);
  333.      end;
  334.  
  335.  
  336. Function INTEGER_FIELD_object.input(var i : integer) : boolean;
  337. var ok : boolean;
  338. var s  : string;
  339.     yy,mm,dd : integer;
  340.      begin
  341.      FLD_working := trimstr(integerstr(ii,l));
  342.      ok := FIELD_object.input(FLD_working);
  343.      ii := StrInt(FLD_working);
  344.      display(ii);
  345.      i := ii;
  346.      input := ok;
  347.      end;
  348.  
  349.  
  350.  
  351.  
  352. {SECTION  LONGINT_FIELD_object }
  353. Procedure LONGINT_FIELD_object.init(row,col,llx : byte; pr : string);
  354. var s : string;
  355.     lx : integer;
  356.      begin
  357.      ll := 0;
  358.      if llx > 9 then lx := 9
  359.      else lx := llx;
  360.      lx := MaxFieldLen(col,lx);
  361.      FIELD_object.init(row,col,lx,pr);
  362.      end;
  363.  
  364.  
  365. Procedure LONGINT_FIELD_object.dump;
  366.      begin
  367.      FIELD_object.dump;
  368.      write('  [',ll,'] ');
  369.      end;
  370.  
  371.  
  372. Procedure LONGINT_FIELD_object.display( lng : longint );
  373. var s : string;
  374.      begin
  375.      ll := lng;
  376.      FLD_working := longintstr(ll,l);
  377.      FIELD_object.display(FLD_working);
  378.      end;
  379.  
  380.  
  381. Function LONGINT_FIELD_object.input(var lng : longint) : boolean;
  382. var ok : boolean;
  383. var s  : string;
  384.     yy,mm,dd : integer;
  385.      begin
  386.      FLD_working := trimstr(longintstr(ll,l));
  387.      ok := FIELD_object.input(FLD_working);
  388.      ll := StrLong(FLD_working);
  389.      display(ll);
  390.      lng := ll;
  391.      input := ok;
  392.      end;
  393.  
  394.  
  395.  
  396.  
  397.  
  398. {SECTION  ZInitialization }
  399.      begin {Initialization}
  400.      end.
  401.